home *** CD-ROM | disk | FTP | other *** search
/ MacWorld: Complete Mac Interactive / Macworld Complete Mac Interactive CD)(1994).iso / Software / More Shareware⁄Freeware / NIH Image 1.55 f (non fpu) / Macros / Measurement Macros < prev    next >
Text File  |  1994-04-11  |  14KB  |  622 lines
  1. macro 'Particle Analysis Test';
  2. var
  3.   x,y,rows,columns,maxradius,radius:integer;
  4. begin
  5.   SaveState;
  6.   rows:=5; columns:=5;
  7.   maxradius:=rows*columns;
  8.   SetForegroundColor(255);
  9.   SetBackgroundColor(0);
  10.   SetNewSize(columns*maxradius*2+20,rows*maxradius*2+20);
  11.   MakeNewWindow('Objects');
  12.   radius:=1;
  13.   for y:=0 to columns-1 do
  14.     for x:=0 to rows-1 do begin
  15.       MakeOvalRoi(x*maxradius*2+10,y*maxradius*2+10,radius*2,radius*2);
  16.       Fill;
  17.       radius:=radius+1;
  18.     end;
  19.   KillRoi;
  20.   SetParticleSize(1,9999);
  21.   LabelParticles(true);
  22.   OutlineParticles(true);
  23.   SetOptions('Area, Perimeter, Major, Minor');
  24.   AnalyzeParticles;
  25.   SetUser1Label('Perim.d');
  26.   SetUser2Label('Area');
  27.   for radius:=1 to maxradius do begin
  28.     rUser1[radius]:=2*3.14159*radius;
  29.     rUser2[radius]:=3.14159*sqr(radius);
  30.   end;
  31.   ShowResults;
  32.   RestoreState;
  33. end;
  34.  
  35.  
  36. macro 'Count Particles at Random Locations';
  37. var
  38.   n,i,width,height,PicID,nLocations:integer;
  39.   size:real;
  40. begin
  41.   RequiresVersion(1.44);
  42.   nLocations:=10;
  43.   size:=0.25;
  44.   n:=1;
  45.   GetPicSize(width,height);
  46.   PicID:=PicNumber;
  47.   SetUser1Label('Count');
  48.   SetOptions('User1');
  49.   for i:=1 to nLocations do begin
  50.     SelectPic(PicID);
  51.     MakeRoi((1-size)*width*random,(1-size)*height*random,size*width,size*height);
  52.     Duplicate('Temp');;
  53.     SetDensitySlice(255,255);
  54.     AnalyzeParticles;
  55.     Dispose;
  56.     rUser1[i]:=rCount;
  57.   end;
  58.   KillRoi;
  59.   SetCounter(nLocations);
  60.   ShowResults;
  61. end;
  62.  
  63.  
  64. macro 'Make Circle from Line';
  65. var
  66.   x1,x2,y1,y2,top,left,width,height:integer;
  67.   xcenter,ycenter,radius:integer;
  68. begin
  69.   GetLine(x1,y1,x2,y2,width);
  70.   if x1<0 then begin
  71.     PutMessage('This macro requires a line selection.');
  72.     exit;
  73.   end;
  74.   xcenter:=x1+(x2-x1)/2;
  75.   ycenter:=y1+(y2-y1)/2;
  76.   radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  77.   MakeOvalROI(xcenter-radius,ycenter-radius,radius*2,radius*2);
  78. end;
  79.  
  80.  
  81. macro 'Display Calibration Table';
  82. {
  83. Stores 0-255(all possible gray values) in the User1 column
  84. and the 256 corresponding calibrated values in the User2 column.
  85. Max Measurements must be set to 256 or greater. Use the Export
  86. command to export the calibration table to a text file. The two
  87. columns will be identical if the image is not calibrated.
  88. }
  89. var
  90.   i:integer;
  91.   v:real;
  92. begin
  93.   RequiresVersion(1.44);
  94.   SetCounter(256);
  95.   SetUser1Label('value');
  96.   SetUser2Label('cvalue');
  97.   for i:=0 to 255 do begin
  98.     rUser1[i+1]:=i;
  99.     rUser2[i+1]:=cvalue(i);
  100.   end;
  101.   ShowResults;
  102. end;
  103.  
  104.  
  105. macro 'Measure and draw line [L]';
  106. var
  107.   x1,x2,y1,y2,width:integer;
  108. begin
  109.   GetLine(x1,y1,x2,y2,width);
  110.   if x1<0 then begin
  111.     PutMessage('This macro requires a straight line selection.');
  112.     exit;
  113.   end;
  114.   Measure;
  115.   Fill;
  116.   KillRoi;
  117. end;
  118.  
  119. macro 'Measure and Outline [M]';
  120. begin
  121.   Measure;
  122.   DrawBoundary;
  123.   DrawBoundary;
  124. end;
  125.  
  126.  
  127. macro 'Measure All';
  128. {Measures all currently open images using the current selection. There is}
  129. {an implied "Select All" if the active image doesn't have a selection.}
  130. var
  131.   i,left,top,width,height:integer;
  132. begin
  133.   ResetCounter;
  134.   for i:=1 to nPics do begin
  135.     SelectPic(i);
  136.     RestoreROI;
  137.     Measure;
  138.   end;
  139. end;
  140.  
  141.  
  142. macro 'Measure All from Disk';
  143. {
  144. Reads from disk and measures a set of images too large to simultaneously
  145. fit in memory. The image names names must be in the form '01', '02', etc.
  146. Before starting, open and outline the first image('01').
  147. }
  148. var
  149.   i,width,height:integer;
  150. begin
  151.   GetPicSize(width,height);
  152.   if width=0 then begin
  153.     PutMessage('Before running this macro, open and outline the first image("01") in the series.');
  154.     exit;
  155.   end;
  156.   ResetCounters;
  157.   Measure;
  158.   close;
  159.   for i:=2 to 1000 do begin
  160.     open(i:2);
  161.     RestoreROI;
  162.     Measure;
  163.     close;
  164.   end;
  165. end;
  166.  
  167.  
  168. macro 'Paste Results'
  169. {Use the Measure command, the ruler tool, or the pointing tool to}
  170. {make up to about 10 measurements, then use this macro to paste}
  171. {the results into the upper left corner of the window.}
  172. begin
  173.   SetFont('Monaco');
  174.   SetFontSize(9);
  175.   SetText('Plain; Align Left');
  176.   SetOption; {Copy headings}
  177.   CopyResults;
  178.   MakeRoi(-10,0,250,150);
  179.   Paste;
  180.   KillRoi;
  181.   ResetCounter;
  182. end;
  183.  
  184.  
  185. macro 'Measure Redirected and Label'
  186. begin
  187.   Redirect(true);
  188.   Measure;
  189.   Redirect(false);
  190.   MarkSelection;
  191.   RestoreRoi;
  192. end;
  193.  
  194.  
  195. macro 'Reset Measurement Options';
  196. {Resets the Options dialog box in the Analyze menu to the default settings.}
  197. begin
  198.   RequiresVersion(1.44);
  199.   SetOptions('Area; Mean');
  200.   Redirect(false);
  201.   LabelParticles(true);
  202.   OutlineParticles(false);
  203.   IgnoreParticlesTouchingEdge(false);
  204.   IncludeInteriorHoles(false);
  205.   WandAutoMeasure(false);
  206.   AdjustAreas(false);
  207.   SetParticleSize(1,999999);
  208.   SetPrecision(2);
  209. end;
  210.  
  211.  
  212. macro 'Set Threshold…';
  213. var
  214.   lower,upper:integer;
  215. begin
  216.   lower:=GetNumber('Lower:',1);
  217.   upper:=GetNumber('Upper:',254);
  218.   SetDensitySlice(lower,upper);
  219. end;
  220.  
  221.  
  222. macro 'Measure Accumulated Perimeter[A]';
  223. {
  224. Measures perimeter and computes accumulated perimeter,
  225. storing it in the User1 column.
  226. }
  227. var
  228.   i:integer;
  229.   Total:real;
  230. begin
  231.   SetOptions('Area; Mean; Perimeter; User1');
  232.   SetUser1Label('Total');
  233.   Measure;
  234.   Total:=0;
  235.   for i:=1 to rCount do Total:=Total+rLength[i];
  236.   rUser1[rCount]:=Total;
  237.   UpdateResults;
  238. end;
  239.  
  240.  
  241. macro 'Count Black and White Pixels [B]';
  242. {
  243. Counts the number of black and white pixels in the current
  244. selection and stores the counts in the User1 and User2 columns.
  245. }
  246. begin
  247.   RequiresVersion(1.44);
  248.   SetUser1Label('Black');
  249.   SetUser2Label('White');
  250.   Measure;
  251.   rUser1[rCount]:=histogram[255];
  252.   rUser2[rCount]:=histogram[0];
  253.   UpdateResults;
  254. end;
  255.  
  256.  
  257. macro 'Compute Percent Black and White';
  258. {
  259. Computes the percentage of back and white pixels in the
  260. current selection. This macro only works with binary images.
  261. }
  262. var
  263.   nPixels,mean,mode,min,max:real;
  264. begin
  265.   RequiresVersion(1.44);
  266.   SetUser1Label('Black');
  267.   SetUser2Label('White');
  268.   Measure;
  269.   GetResults(nPixels,mean,mode,min,max);
  270.   rUser1[rCount]:=histogram[255]/nPixels;
  271.   rUser2[rCount]:=histogram[0]/nPixels;
  272.   UpdateResults;
  273.   if (histogram[0]+histogram[255])<>nPixels
  274.     then PutMessage('This macro requires a binary image.');
  275. end;
  276.  
  277.  
  278. macro 'Compute Area Percentage [P]';
  279. {
  280. Computes the percentage of foreground
  281. pixels in the current selection.
  282. }
  283. var
  284.   mean,mode,min,max:real;
  285.   i,lower,upper,fPixels,nPixels,count:integer;
  286. begin
  287.   RequiresVersion(1.50);
  288.   SetUser1Label('%');
  289.   Measure;
  290.   GetResults(nPixels,mean,mode,min,max);
  291.   GetThresholds(lower,upper);
  292.   if (lower=0) and (upper=0) and 
  293.      ((histogram[0]+histogram[255])<>nPixels)
  294.      then begin
  295.        PutMessage('This macro requires a binary or thresholded image.');
  296.        exit;
  297.      end;
  298.   if nPixels=0 then begin
  299.   end;
  300.   if (lower=0) and (upper=0) then begin
  301.     if nPixels=0
  302.       then rUser1[rCount]:=0
  303.       else rUser1[rCount]:=(histogram[255]/nPixels)*100;
  304.     UpdateResults;
  305.     exit;
  306.   end;
  307.   fPixels:=0;
  308.   nPixels:=0;
  309.   for i:=0 to 255 do begin
  310.     count:=histogram[i];
  311.     nPixels:=nPixels+count;
  312.     if (i>=lower) and (i<=upper)
  313.       then fPixels:=fPixels+count;
  314.   end;
  315.   rUser1[rCount]:=(fPixels/nPixels)*100;
  316.   UpdateResults;
  317. end;
  318.  
  319.  
  320. macro 'Compute Average and Total Area [T]';
  321. {
  322. Computes average and accumulated area and stores 
  323. the them in the Major and Minor Axis columns.
  324. }
  325. var
  326.   i:integer;
  327.   sum:real;
  328. begin
  329.   RequiresVersion(1.44);
  330.   SetUser1Label('Avg');
  331.   SetUser2Label('Total');
  332.   SetOptions('Area; User1; User2');
  333.   Measure;
  334.   sum:=0;
  335.   for i:=1 to rCount do sum:=sum+rArea[i];
  336.   rUser1[rCount]:=sum/rCount;
  337.   rUser2[rCount]:=sum;
  338.   UpdateResults;
  339. end;
  340.  
  341.  
  342. macro 'Measure Circularity';
  343. begin
  344.   SetUser1Label('Shape');
  345.   Measure;
  346.   rUser1[rCount]:=4*3.14159265*(rArea[rCount]/sqr(rLength[rCount]));
  347.   UpdateResults;
  348. end;
  349.  
  350.  
  351. macro 'Measure Mean * Area';
  352. begin
  353.   SetUser1Label('Mean*Area');
  354.   Measure;
  355.   rUser1[rCount]:=rMean[rCount]*rArea[rCount];
  356.   UpdateResults;
  357. end;
  358.  
  359.  
  360. macro 'Draw Fitted Ellipse in White';
  361. var
  362.   left,top,width,height:real;
  363. begin
  364.   GetRoi(left,top,width,height);
  365.   if width=0 then begin
  366.     PutMessage('This macro requires a selection.');
  367.     exit;
  368.   end;
  369.   SetOptions('Area; Mean; X-Y Center');
  370.   Measure;
  371.   SetOption; MarkSelection;
  372.   KillRoi;
  373.   SelectAll;
  374.   KillRoi;
  375.  end;
  376.  
  377. macro 'Draw XY Center';
  378. var
  379.   left,top,width,height,x,y:real;
  380. begin
  381.   RequiresVersion(1.44);
  382.   GetRoi(left,top,width,height);
  383.   if width=0 then begin
  384.     PutMessage('This macro requires a selection.');
  385.     exit;
  386.   end;
  387.   SaveState; {Invert Y status saved starting with V1.44b21}
  388.   InvertY(false);
  389.   SetForegroundColor(255); {black}
  390.   SetOptions('Area; Mean; X-Y Center'); {XY Center}
  391.   Measure;
  392.   KillRoi;
  393.   x:=rX[rCount];
  394.   y:=rY[rCount];
  395.   MoveTo(x-5,y);
  396.   LineTo(x+5,y);
  397.   MoveTo(x,y-5);
  398.   LineTo(x,y+5);
  399.   RestoreState;
  400. end;
  401.  
  402.  
  403.  
  404.  
  405. macro 'Compute Spatial Scale';
  406. var
  407.   scale:real;
  408. begin
  409.   MakeLineRoi(0,0,100,0);
  410.   Measure;
  411.   KillRoi;
  412.   Scale:=100/rLength[rCount];
  413.   if scale=1
  414.     then PutMessage('Image is not spatially calibrated')
  415.     else PutMessage('Scale=',scale:1:4,' pixels/unit');
  416. end;
  417.  
  418.  
  419. procedure StoreZeros;
  420. begin
  421.   Measure;
  422.   rArea[rCount]:=0;
  423.   rMean[rCount]:=0;
  424.   rStdDev[rCount]:=0;
  425.   rX[rCount]:=0;
  426.   rY[rCount]:=0;
  427.   rLength[rCount]:=0;
  428.   rMajor[rCount]:=0;
  429.   rMinor[rCount]:=0;
  430.   rAngle[rCount]:=0;
  431.   rUser1[rCount]:=0;
  432.   rUser2[rCount]:=0;
  433.   UpdateResults;
  434. end;
  435.  
  436. macro 'Store Break in Results [S]';
  437. {Stores a row of zeros in the results table.}
  438. begin
  439.   StoreZeros;
  440. end;
  441.  
  442. macro 'Compute Means';
  443. var
  444.   n,i:integer;
  445. begin
  446.   n:=rCount;
  447.   StoreZeros;
  448.   StoreZeros;
  449.   for i:=1 to n do begin
  450.     rArea[rCount]:=rArea[rCount]+rArea[i];
  451.     rMean[rCount]:=rMean[rCount]+rMean[i];
  452.     rStdDev[rCount]:=rStdDev[rCount]+rStdDev[i];
  453.     rX[rCount]:=rX[rCount]+rX[i];
  454.     rY[rCount]:=rY[rCount]+rY[i];
  455.     rLength[rCount]:=rLength[rCount]+rLength[i];
  456.     rMajor[rCount]:=rMajor[rCount]+rMajor[i];
  457.     rMinor[rCount]:=rMinor[rCount]+rMinor[i];
  458.     rAngle[rCount]:=rAngle[rCount]+rAngle[i];
  459.     rUser1[rCount]:=rUser1[rCount]+rUser1[i];
  460.     rUser2[rCount]:=rUser2[rCount]+rUser2[i];
  461.   end; 
  462.   rArea[rCount]:=rArea[rCount]/n;
  463.   rMean[rCount]:=rMean[rCount]/n;
  464.   rStdDev[rCount]:=rStdDev[rCount]/n;
  465.   rX[rCount]:=rX[rCount]/n;
  466.   rY[rCount]:=rY[rCount]/n;
  467.   rLength[rCount]:=rLength[rCount]/n;
  468.   rMajor[rCount]:=rMajor[rCount]/n;
  469.   rMinor[rCount]:=rMinor[rCount]/n;
  470.   rAngle[rCount]:=rAngle[rCount]/n;
  471.   rUser1[rCount]:=rUser1[rCount]/n;
  472.   rUser2[rCount]:=rUser2[rCount]/n;
  473.   UpdateResults;
  474. end;
  475.  
  476. macro 'Measure both Raw and Calibrated';
  477. {
  478. This macro is a variation of the Measure command that displays the number
  479. of pixels in User1 and uncalibrated(raw) mean density in User2. It takes
  480. advantage of the fact that GetResults always returns uncalibrated values.
  481. }
  482. var
  483.   nPixels,mean,mode,min,max:real;
  484. begin
  485.   SetUser1Label('Pixels');
  486.   SetUser2Labe2('Raw Mean');
  487.   Measure;
  488.   GetResults(nPixels,mean,mode,min,max);
  489.   rUser1[rCount]:=nPixels;
  490.   rUser2[rCount]:=mean;
  491.   UpdateResults;
  492. end;
  493.  
  494.  
  495. macro 'Mark Centers';
  496. {Replaces each object in the image with a single pixel.}
  497. var i:integer;
  498. begin
  499.    Duplicate('Center');
  500.    SetScale(0,'pixels');
  501.    AutoThreshold;
  502.    AnalyzeParticles;
  503.    SelectAll;
  504.    Clear;
  505.    For i:=1 to rCount do
  506.       PutPixel(rX[i],rY[i],255);
  507. end;
  508.  
  509. macro 'Density Slice [D]';
  510. var
  511.   t1,t2:integer;
  512. begin
  513.   GetThresholds(t1,t2);
  514.   if (t1=0) and (t2=0) 
  515.     then SetDensitySlice(255,255)
  516.     else SetDensitySlice(0,0);
  517. end;
  518.  
  519. macro 'Set Scale and Aspect Ratio';
  520. {
  521. Sets the spatial scale and aspect ratio to predefined
  522. values contained in an image names "scale". This image
  523. can be very small, say 20x10. The directory (folder) path
  524. in the open statement will probably have to be changed.
  525. }
  526. begin
  527.   open('hd400:image:scale');
  528.   PropagateSpatial;
  529.   Dispose;
  530. end;
  531.  
  532. macro 'Save Results to Text File…';
  533. {This is an example of how to save results to a text file.}
  534. begin
  535.   Measure;
  536.   NewTextWindow('My Results');
  537.   writeln('Area=',rArea[rCount]:1:3);
  538.   writeln('Mean=',rMean[rCount]:1:3);
  539.   SaveAs;
  540. end;
  541.  
  542. macro 'Find Radial Distances';
  543. {Finds center to edge distances along radial lines and displays them in User1.} 
  544. var
  545.   RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  546.   x1,y1,x2,y2,count,ppv:integer;
  547.   pi,angle,delta,min,max,scale:real;
  548.   line,i,nLines,radius,r:integer;
  549.   unit:string;
  550. begin
  551.   RequiresVersion(1.55);
  552.   SaveState;
  553.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  554.   if RoiWidth=0 then begin
  555.     PutMessage('Selection Required.');
  556.     exit;
  557.   end;
  558.   GetScale(scale,unit);
  559.   MoveRoi(-RoiLeft,-RoiTop);
  560.   KillRoi;
  561.   RestoreRoi;
  562.   SetForegroundColor(255);
  563.   SetBackgroundColor(0);
  564.   SetNewSize(RoiWidth,RoiHeight);
  565.   MakeNewWindow('Temp');
  566.   RestoreRoi;
  567.   SetOptions('X-Y Center');
  568.   Measure;
  569.   DrawBoundary;
  570.   KillRoi;
  571.   x1:=rX[rCount]*scale;
  572.   y1:=rY[rCount]*scale;
  573.   radius:=sqrt(sqr(x1)+sqr(y1));
  574.   r:=sqrt(sqr(RoiWidth-x1)+sqr(y1));
  575.   if r>radius then radius:=r;
  576.   r:=sqrt(sqr(RoiWidth-x1)+sqr(RoiHeight-y1));
  577.   if r>radius then radius:=r;
  578.   r:=sqrt(sqr(x1)+sqr(RoiHeight-y1));
  579.   if r>radius then radius:=r;
  580.   nLines:=GetNumber('Number of Radial Lines:',36);
  581.   pi:=3.14159;
  582.   delta:=2.0*pi/nLines;
  583.   angle:=0.0;
  584.   ResetCounter;
  585.   SetUser1Label('Dist.');
  586.   SetOptions('User1');
  587.   for line:=1 TO nLines do begin
  588.     x2:=x1+round(radius*cos(angle));
  589.     y2:=y1+round(radius*sin(angle));
  590.     MakeLineRoi(x1,y1,x2,y2);
  591.     GetPlotData(count,ppv,min,max);
  592.     Fill;
  593.     i:=count;
  594.     repeat
  595.       i:=i-1;
  596.     until (i<=0) or (PlotData[i]>0);
  597.     rUser1[line]:=i;
  598.     angle:=angle+delta;
  599.   end;
  600.   KillRoi;
  601.   if scale<>1 then
  602.     for i:=1 to nLines do rUser1[i]:=rUser1[i]/scale;
  603.   SetCounter(nLines);
  604.   RestoreState;
  605.   ShowResults;
  606. end;
  607.  
  608. Macro 'Copy Results to Clipboard with Headers';
  609. begin
  610.   SelectWindow('Results');
  611.   SetOption; Copy;
  612. end;
  613.  
  614. Macro 'Export Results with Headers';
  615. begin
  616.   SetExport('Measurements');
  617.   SetOption; Export('HD80:Image:Results');
  618. end;
  619.  
  620.  
  621.  
  622.